home *** CD-ROM | disk | FTP | other *** search
- #! /usr/bin/perl -w
-
- use strict;
- use Getopt::Long;
-
- my $progname = "update-locale";
- my $locale_file = "/etc/default/locale";
-
- my $help = 0;
- my $reset = 0;
- # Kept for compatibility reasons
- my $remove = 0;
- my $no_checks = 0;
-
- GetOptions(
- 'reset' => \$reset,
- 'remove' => \$remove,
- 'locale-file=s' => \$locale_file,
- 'no-checks' => \$no_checks,
- 'h|help' => \$help,
- );
-
- sub usage
- {
- my $rc = shift;
- print STDERR "Usage: $progname [OPTIONS] [LANG=locale] [LC_NUMERIC=locale] ...
- Options:
- --help display this message and exit
- --reset ignore variables defined in the locale file
- --locale-file=FILE file containing locale variables
- (Default: /etc/default/locale)
- --no-checks do not perform sanity checks on locale variables
- ";
- exit $rc;
- }
-
- $help && usage(0);
-
- # Process command-line arguments
- my %arg = ();
- my $content = '';
- my $mode = 0644;
- if (-r $locale_file)
- {
- # Keep file mode
- $mode = (stat($locale_file))[2] & 07777;
- # Read current values
- open(IN, "<", $locale_file)
- or die "$progname: Unable to read $locale_file: $!\n";
- while (<IN>)
- {
- $content .= $_;
- next unless m/^(\w+)=(.*)/;
- $arg{$1} = $2 unless $reset;
- }
- close(IN)
- or die "$progname: Unable to close $locale_file: $!\n";
- $content =~ s/^(\s*\w+=)/#$1/mg;
- $content .= "\n" unless $content =~ m/\n$/s;
- }
- else
- {
- $content = "# File generated by $progname\n";
- }
- for (@ARGV)
- {
- if (m/(.*?)=(.*)/)
- {
- $arg{$1} = $2;
- }
- else
- {
- delete $arg{$_};
- }
- }
-
- my $env = '';
- my ($key, $value);
- while (($key, $value) = each %arg)
- {
- $env .= " $key=$value";
- $content =~ s/^#\s*$key=.*/$key=$value/m or
- $content .= "$key=$value\n";
- }
-
- # Sanity checks
- if ($no_checks == 0)
- {
- # Check that this locale does exist
- my $charset = `LANG= LC_CTYPE= LC_NUMERIC= LC_TIME= LC_COLLATE= LC_MONETARY= LC_MESSAGES= LC_PAPER= LC_NAME= LC_ADDRESS= LC_TELEPHONE= LC_MEASUREMENT= LC_IDENTIFICATION= LC_ALL= $env locale charmap 2>&1`;
- die "*** $progname: Error: invalid locale settings: $env\n"
- if ($charset =~ m/Cannot set/);
- # If LANGUAGE is set, its first value must be compatible with LC_MESSAGES
- if (defined $arg{LANGUAGE})
- {
- my $language = $arg{LANGUAGE};
- $language =~ s/["']//g;
- $language =~ s/[.:_].*//;
- my $msg = '';
- my $var = '';
- for (qw(LANG LC_MESSAGES LC_ALL))
- {
- if (defined $arg{$_})
- {
- $var = $_;
- $msg = $arg{$_};
- }
- }
- $msg =~ s/["']//g;
- die "*** $progname: Error: LANGUAGE ($arg{LANGUAGE}) is not compatible with $var ($msg)\n"
- if ($msg !~ m/^$language/ && $var ne ''
- && $msg ne 'C' && $msg ne 'POSIX'
- && $language ne 'C' && $language ne 'POSIX');
- }
- }
-
- # Write locale file
- open(OUT, ">", $locale_file)
- or die "$progname: Unable to write $locale_file: $!\n";
- print OUT $content;
- close(OUT)
- or die "$progname: Unable to close $locale_file: $!\n";
- chmod($mode, $locale_file)
- or die "$progname: Unable to chmod $locale_file: $!\n";
-
- 1;
-